home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0019_A CRT Replacement.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  7KB  |  286 lines
  1. unit scrn;
  2. {$D-,I-,S-,V-}
  3. interface
  4. Uses
  5.         Dos;
  6. Const
  7.       display : Boolean = true;
  8.       FGround : Byte = 0;
  9.       BGround : Byte = 0;
  10.       attribute : Byte = 0;
  11.       apage : Word = $B800;
  12.       apoint : Word = 0;
  13.       { foreground and background colors }
  14.       Black        = 0;
  15.       Blue         = 1;
  16.       Green        = 2;
  17.       Cyan         = 3;
  18.       Red          = 4;
  19.       Magenta      = 5;
  20.       Brown        = 6;
  21.       LightGray    = 7;
  22.  
  23.       { foreground colors }
  24.       DarkGray     = 8;
  25.       LightBlue    = 9;
  26.       LightGreen   = 10;
  27.       LightCyan    = 11;
  28.       LightRed     = 12;
  29.       LightMagenta = 13;
  30.       Yellow       = 14;
  31.       White        = 15;
  32.  
  33.       { add for blinking characters }
  34.       Blink        = 128;
  35.  
  36. VAR
  37.         regs : Registers;
  38.  
  39. Function GetMode : Byte;
  40. {returns the current video mode}
  41.  
  42. Procedure SetMode (m : Byte);
  43. {sets the video mode}
  44.  
  45. Procedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);
  46. {scrolls the window up (nbr is +) or down (nbr is -)}
  47. {If nbr is 0 or out of range then the screen clears}
  48. {ur is the upper row, lc is the left column,
  49.  lr is the lower row, and rc is the right column}
  50. {Note:  using an out-of-range number may have unpredictable
  51.  results on the colors...it is not recommended}
  52.  
  53. Procedure SetCursor (s, e : Byte);
  54. {sets the size of the cursor}
  55. {s is the starting line, e is the ending line}
  56.  
  57. Procedure SetAPage (page : Word);
  58. {Set the Active (drawing) page}
  59.  
  60. Procedure SetVPage (vpage : Byte);
  61. {Set the display page}
  62.  
  63. Function DisplayCursor (display1 : Boolean) : Boolean;
  64. {hides or displays the cursor}
  65.  
  66. Function Xis : Byte;
  67. {Tells you what the X coordinate is for the current active page}
  68.  
  69. Function Yis : Byte;
  70. {Tells you what the Y coordinate is for the current active page}
  71.  
  72. Procedure PXY (x, y : Byte);
  73. {sets the coordinates on the current active page}
  74. {To move the cursor on the visual page, first make the visual page
  75.  and active page the same}
  76. {x is the row, y is the column}
  77.  
  78. Procedure SetFGround (FG : Byte);
  79. {sets the foreground color}
  80. {constants can be used}
  81. {add 128 or the constant BLINK to make the foreground blink}
  82.  
  83. Procedure SetBGround (BG : Byte);
  84. {sets the background color}
  85. {constants can be used}
  86.  
  87. Procedure PWrite (S : String);
  88. {writes a string to the current active page}
  89. {numbers must be converted to a string before calling this procedure}
  90.  
  91. Procedure PWriteln (S : String);
  92.  
  93. Procedure ClrScrn;
  94. {Clear the current active page}
  95.  
  96. implementation
  97.  
  98. Function GetMode : Byte;
  99. {returns the current video mode}
  100. Begin
  101.      regs.ah := $0F;
  102.      Intr($10,regs);
  103.      GetMode := regs.al;
  104. End;
  105.  
  106. Procedure SetMode (m : Byte);
  107. {sets the video mode}
  108. Begin
  109.      regs.ah := 0;
  110.      regs.al := m;
  111.      Intr($10,regs);
  112. End;
  113.  
  114. Procedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);
  115. {scrolls the window up (nbr is +) or down (nbr is -)}
  116. {If nbr is 0 or out of range then the screen clears}
  117. Begin
  118.         Dec(ur);
  119.         Dec(lc);
  120.         Dec(lr);
  121.         Dec(rc);
  122.         If nbr < 0 Then regs.ah := 7 Else regs.ah := 6;
  123.         regs.al := Abs(nbr);
  124.         regs.bh := attribute;
  125.         regs.ch := ur;
  126.         regs.cl := lc;
  127.         regs.dh := lr;
  128.         regs.dl := rc;
  129.         Intr($10,regs);
  130. End;
  131.  
  132. Procedure SetCursor (s, e : Byte);
  133. Begin
  134.         regs.ah := 1;
  135.         regs.ch := s;
  136.         regs.cl := e;
  137.         Intr($10,regs);
  138. End;
  139.  
  140. Procedure SetAPage (page : Word);
  141. Begin
  142.         apage := $B800 + (page * $100);
  143. End;
  144.  
  145. Procedure SetVPage (vpage : Byte);
  146. Begin
  147.         regs.ah := 5;
  148.         regs.al := vpage;
  149.         Intr($10,regs);
  150. End;
  151.  
  152. Function DisplayCursor(display1 : Boolean) : Boolean;
  153. Begin
  154.         If Not(display1) Then Begin
  155.            regs.dh := 50;
  156.            regs.dl := 0;
  157.            End
  158.         Else regs.dx := apoint;
  159.         regs.ah := 2;
  160.         regs.bh := (apage - $B800) DIV $100;
  161.         Intr($10,regs);
  162.         display := display1;
  163. End;
  164.  
  165. Function Xis : Byte;
  166. Var        cpage : Word;
  167. Begin
  168.         cpage := (apage - $B800) DIV $100;
  169.         Xis := (Mem[$40:$51+(cpage * 2)]) + 1;
  170. End;
  171.  
  172. Function Yis : Byte;
  173. Var        cpage : Word;
  174. Begin
  175.         cpage := (apage - $B800) DIV $100;
  176.         Yis := (Mem[$40:$50+(cpage * 2)]) + 1;
  177. End;
  178.  
  179.  
  180. Procedure PXY (x, y : Byte);
  181. Begin
  182.         Dec(x);
  183.         Dec(y);
  184.         regs.dh := x;
  185.         regs.dl := y;
  186.         regs.ah := 2;
  187.         regs.bh := (apage - $B800) DIV $100;
  188.         Intr($10,regs);
  189.         If Not(display) Then Begin
  190.            regs.dh := 50;
  191.            regs.dl := 0;
  192.         regs.ah := 2;
  193.         regs.bh := (apage - $B800) DIV $100;
  194.         Intr($10,regs);
  195.         End;
  196.         apoint := x * 80 * 2 + y * 2;
  197. End;
  198.  
  199. Procedure SetFGround (FG : Byte);
  200. Begin
  201.         FGround := FG;
  202.         attribute := BGround * 16 + FGround;
  203. End;
  204.  
  205. Procedure SetBGround (BG : Byte);
  206. Begin
  207.         BGround := BG;
  208.         attribute := BGround * 16 + FGround;
  209. End;
  210.  
  211. Procedure PWrite (S : String);
  212. Var
  213.         Len, x, y : Byte;
  214.         tmp : Word;
  215. Begin
  216.         If Length(S) = 0 Then Exit;
  217.         tmp := apoint;
  218.         For Len := 0 To Length(S) - 1 Do Begin
  219.             Mem[apage:apoint+Len] := Ord(S[Len+1]);
  220.             Inc(apoint);
  221.             Mem[apage:apoint+Len] := attribute;
  222.         End;
  223.         apoint := (tmp + Length(S) * 2) DIV 2;
  224.         y := apoint MOD 80;
  225.         x := apoint DIV 80;
  226.         Inc(x);
  227.         Inc(y);
  228.         PXY(x,y);
  229.         If Not(display) Then Begin
  230.            regs.dh := 50;
  231.            regs.dl := 0;
  232.         regs.ah := 2;
  233.         regs.bh := (apage - $B800) DIV $100;
  234.         Intr($10,regs);
  235.         End;
  236. End;
  237.  
  238. Procedure PWriteln (S : String);
  239. Var
  240.         Len, x, y : Byte;
  241.         tmp : Word;
  242. Begin
  243.         If Length(S) = 0 Then Exit;
  244.         tmp := apoint;
  245.         For Len := 0 To Length(S) - 1 Do Begin
  246.             Mem[apage:apoint+Len] := Ord(S[Len+1]);
  247.             Inc(apoint);
  248.             Mem[apage:apoint+Len] := attribute;
  249.         End;
  250.         apoint := (tmp + Length(S) * 2) DIV 2;
  251.         x := apoint DIV 80 + 2;
  252.         y := 1;
  253.         PXY(x,y);
  254.         If Not(display) Then Begin
  255.            regs.dh := 50;
  256.            regs.dl := 0;
  257.         regs.ah := 2;
  258.         regs.bh := (apage - $B800) DIV $100;
  259.         Intr($10,regs);
  260.         End;
  261. End;
  262.  
  263. Procedure ClrScrn;
  264. Var
  265.         x : Word;
  266. Begin
  267.         x := 0;
  268.         While x < 4048 Do Begin
  269.           Mem[apage:x] := $20;
  270.           Inc(x);
  271.           Mem[apage:x] := attribute;
  272.           Inc(x);
  273.           End;
  274. End;
  275.  
  276. {initializes the foreground and backbround colors}
  277. Begin
  278.         regs.ah := 8;
  279.         regs.bh := 0;
  280.         Intr($10,regs);
  281.         attribute := regs.ah;
  282.         FGround := attribute MOD 16;
  283.         BGround := (attribute - FGround) DIV 16;
  284. End.
  285.  
  286.